home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / sources.lha / sources / comp / back_end / vaxemit.t < prev    next >
Encoding:
Text File  |  1988-02-05  |  4.4 KB  |  132 lines
  1. (herald vaxemit)
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26.  
  27. (define (generate-move ref1 ref2)
  28.   (if (neq? ref1 ref2)
  29.       (if (and (pair? ref1) (null? (cdr ref1)))
  30.           (emit vax/moval (car ref1) ref2)
  31.           (emit vax/movl ref1 ref2))))
  32.  
  33. (define (generate-push access)
  34.   (increment-stack)
  35.   (if (and (pair? access) (null? (cdr access)))
  36.       (emit vax/pushal (car access))
  37.       (emit vax/pushl access )))
  38.  
  39. (define-integrable (generate-pop access)
  40.   (emit vax/movl (@r+ SP 0) access))
  41.  
  42. (define (adjust-stack-pointer n)
  43.   (if (fxn= n 0) (emit vax/addl2 ($ n) SP)))
  44.                                      
  45. (define (generate-move-address from to)
  46.   (cond ((register? to)
  47.          (if (or (atom? from)
  48.                  (neq? (car from) to)
  49.                  (neq? (cdr from) 0))
  50.              (emit vax/moval from to)))
  51.         (else
  52.          (emit vax/moval from to))))
  53.  
  54. (define-integrable (generate-slink-jump offset)
  55.   (emit vax/jsb (*d@r 11 offset)))
  56.   
  57. (define-integrable (generate-jump-to-subroutine fg)
  58.   (emit vax/jsb fg))
  59.                    
  60. (define-integrable (generate-jump-absolute fg)
  61.   (emit vax/jmp fg))
  62.                    
  63. (define (generate-jump label)
  64.   (emit-jump 'jmp label nil))
  65.  
  66. (define (generate-avoid-jump label)
  67.   (emit-avoid-jump 'jmp label nil))
  68.  
  69. (define (generate-return n-args)               
  70.   (emit vax/mnegl (machine-num (fx+ 1 n-args)) NARGS)
  71.   (emit vax/movl (@r 14) TP)
  72.   (emit vax/jmp (@r 10)))
  73.  
  74. (define (generate-return-without-nargs)
  75.   (emit vax/movl (@r 14) TP)
  76.   (emit vax/jmp (@r 10)))
  77.  
  78.  
  79. (define (generate-general-call proc-var n-args)
  80.   (emit vax/movl  (machine-num (fx+ n-args 1)) NARGS)
  81.   (cond ((and (or (variable-binder proc-var)
  82.           (var-is-vcell? proc-var)))
  83.          (emit vax/jmp (*d@r 11 slink/icall)))
  84.         (else
  85.          (emit vax/movl (d@r P -2) TP)
  86.          (emit vax/jmp (@r 10)))))
  87.     
  88.     
  89. (define-integrable (generate-push-address access)
  90.   (increment-stack)
  91.   (emit vax/pushal access))
  92.  
  93.       
  94. (define-integrable (increment-stack)
  95.   (set *stack-pos* (fx+ *stack-pos* CELL)))
  96.  
  97. (define-integrable (n-decrement-stack n)
  98.   (set *stack-pos* (fx- *stack-pos* (fx* n CELL))))
  99.  
  100. (define (emit op . args)
  101.   (apply %emit op (map! ->field-group args)))
  102.  
  103. (define (->field-group operand)
  104.   (cond ((fg? operand) operand)
  105.         ((fixnum? operand)
  106.          (register->field-group operand))
  107.         ((fixnum? (car operand))
  108.          (d@r (symbolic->machine-reg (car operand)) (cdr operand)))
  109.         (else
  110.          (index (d@r (symbolic->machine-reg (caar operand)) (cdr operand))
  111.                 (symbolic->machine-reg (cdar operand))))))
  112.  
  113. (define (symbolic->machine-reg reg)
  114.   (cond ((fx< reg 0)
  115.          (vref *reserved-registers* (fx- 0 reg)))
  116.         (else reg)))
  117.  
  118. (define (register->field-group reg)
  119.   (cond ((fx< reg 0)
  120.          (r (vref *reserved-registers* (fx- 0 reg))))
  121.         ((fx< reg *real-registers*)
  122.          (r reg))
  123.         (else
  124.          (d@r 12 (fx* (fx- reg *real-registers*) CELL)))))
  125.  
  126.  
  127. (define *reserved-registers*
  128.   '#(nil 10 11 14 12))
  129. ;        TP nil SP TASK
  130.  
  131.  
  132.